home *** CD-ROM | disk | FTP | other *** search
/ Video Toaster 4.2 / Video Toaster v4.2.iso / arexx / modeler / text.lwm < prev    next >
Text File  |  1997-01-01  |  6KB  |  274 lines
  1. /* CMD: Text
  2.  * By Arnie Cachelin © 1993 NewTek Inc. */
  3. /* Tue Sep 14 20:03:06 1993 */
  4.  
  5. libadd = addlib("LWModelerARexx.port",0)
  6. signal on error
  7. signal on syntax
  8.  
  9. call addlib "rexxsupport.library", 0, -30, 0
  10. MATHLIB="rexxmathlib.library"
  11. IF POS(MATHLIB , SHOW('L')) = 0 THEN
  12.   IF ~ADDLIB(MATHLIB , 0 , -30 , 0) THEN DO
  13.         call notify(1,"!Can't find "MATHLIB)
  14.         exit
  15.         END
  16.  
  17. sysnam = 'Compose Text Lines'
  18. filnam = 'ENV:Text.state'
  19. version = 'Text v1.0'
  20. lead=50
  21. typ=1
  22. just=1
  23. deep = 0.1
  24. wide = 0.02
  25. lines=4
  26. line.=""
  27. if (exists(filnam)) then do
  28.     if (~open(state, filnam, 'R')) then break
  29.     if (readln(state) ~= version) then break
  30.     parse value readln(state) with lead typ just .
  31.     do i=1 to lines
  32.       line.i = readln(state)
  33.     end
  34.     call close state
  35. end
  36.  
  37. call req_begin sysnam
  38. styles = 'Flat Block Chisel Round'
  39.  
  40. id_font = req_addcontrol("Font", 'F')
  41. id_typ = req_addcontrol("Text Type", "CH",Styles)
  42. id_just = req_addcontrol('Place','CH',"Center Left Right Justify Scale")
  43. id_deep = req_addcontrol("Depth", 'n', 1)
  44. id_wide = req_addcontrol("Edge Width", 'n', 1)
  45. do i=1 to lines
  46.   id_line.i = req_addcontrol("> ", 's', 35)
  47.   end
  48. id_lead = req_addcontrol("% Leading", 'n')
  49.  
  50. do i=1 to lines
  51.   call req_setval id_line.i, line.i
  52.   end
  53. line.i=""
  54.  
  55. call req_setval id_lead, lead,lead
  56. call req_setval id_just, just,1
  57. call req_setval id_typ, typ,1
  58. call req_setval id_deep, deep,0.1
  59. call req_setval id_wide, wide,0.02
  60.  
  61. if (~req_post()) then do
  62.     call req_end
  63.     exit
  64. end
  65. LineLen=0
  66. font = req_getval(id_font)
  67. do i=1 to lines
  68.   line.i = req_getval(id_line.i)
  69.   if length(line.i)>LineLen then do
  70.     LineLen=length(line.i)
  71.     longest=line.i
  72.     end
  73.   end
  74. lead = req_getval(id_lead)%1
  75. just = req_getval(id_just)-1
  76. typ = req_getval(id_typ)
  77. wide = req_getval(id_wide)
  78. deep = req_getval(id_deep)
  79. call req_end
  80.  
  81. if (open(state, filnam, 'W')) then do
  82.     call writeln state, version
  83.     call writeln state, lead typ just+1
  84.     do i=1 to lines
  85.       call writeln state, line.i
  86.     end
  87.     call close state
  88. end
  89.  
  90.  
  91. if LineLen=0 then exit
  92. call CUT()
  93. if font=0 then do
  94.   if(notify(2,"!Please Load A Font!","I can't continue without one")) then do
  95.     fname=GetFileName("Load Font","toaster:psfonts/")
  96.     if fname~="(none)" then do
  97.       font=fontload(fname)
  98.       if font=0 then do
  99.         call notify(1,"!Can't load font "fname)
  100.         exit
  101.         end
  102.       end
  103.     end
  104.   end
  105.  
  106. LineWidth=MAKETEXT(longest,font,'B',wide*2)
  107. if LineWidth~=0 then call UNDO()
  108. call PASTE()
  109. /* call surface(surf) */
  110. /* call meter_begin lines+2, "Creating Formatted Text Object" */
  111. /* call meter_step() */
  112. h=CreateText(line.1, typ,just)
  113. stmarg=h + lead*h/100
  114. do i=2 to lines
  115. /*   call meter_step() */
  116.   if line.i~="" then do
  117. /*    say i h lead typ*/
  118.     marg=h + lead*h/100
  119.     if type=4 then call MOVE(0 marg 0)
  120.     else call MOVE(0 stmarg 0)
  121.     h=CreateText(line.i, typ)
  122.     end
  123. end
  124. box=boundingbox()
  125. parse var box n x1 x2 y1 y2 z1 z2
  126. call MOVE(0 0-y1 0)
  127. /* call meter_end() */
  128. if (libadd) then call remlib("LWModelerARexx.port")
  129. exit
  130.  
  131. syntax:
  132. error:
  133.   call end_all
  134.         t=Notify(1,'!Rexx Script Error','@'ErrorText(rc),'Line 'SIGL)
  135.   if (libadd) then call remlib("LWModelerARexx.port")
  136.         exit
  137.  
  138. Center: Procedure
  139.   box=boundingbox()  /* Should check out empty list ...  */
  140.   parse var box n x1 x2 y1 y2 z1 z2
  141.   cx=-(x2-x1)/2
  142.   cy=-(y2-y1)/2
  143.   cz=-(z2-z1)/2
  144.   call MOVE(cx cy cz)
  145.   return box
  146.  
  147. CenterX: Procedure
  148.   box=boundingbox()  /* Should check out empty list ...  */
  149.   parse var box n x1 x2 y1 y2 z1 z2
  150.   cx=-(x2-x1)/2
  151.   call MOVE(cx 0 0)
  152.   return (y2-y1) /* Height */
  153.  
  154. CenterScaleX: Procedure
  155.   arg w
  156.   box=boundingbox()  /* Should check out empty list ...  */
  157.   parse var box n x1 x2 y1 y2 z1 z2
  158.   cx=-(x2-x1)/2
  159.   call MOVE(cx 0 0)
  160.   call SCALE(w/2*cx 1 1,0)
  161.   return (y2-y1) /* Height */
  162.  
  163. JustifyX: Procedure expose marg  /* 0=center, left=1, 2=right 3=justify 4=Aspect Justify*/
  164.   arg w, type
  165.   box=boundingbox()  /* Should check out empty list ...  */
  166.   parse var box n x1 x2 y1 y2 z1 z2
  167.   cx=-(x2-x1)/2
  168.   cy=(y2-y1)/2
  169.   select
  170.     when type=4 then do
  171.       call MOVE(cx 0 0)
  172.       call SCALE(w/(-2*cx) w/(-2*cx) 1,0 y2 0)
  173.       end
  174.     when type=3 then do
  175.       call MOVE(cx 0 0)
  176.       call SCALE(w/(-2*cx) 1 1,0)
  177.       end
  178.     when type=2 then call MOVE(2*cx 0 0)
  179.     when type=0 then call MOVE(cx 0 0)
  180.     otherwise nop
  181.     end
  182. if type=4 then return (y2-y1)*w/(-2*cx) /* Height */
  183. else return (y2-y1)
  184.  
  185. Bevel_Slab:
  186.   txlayer=curlayer()
  187.   empty=emptylayers()
  188.   if empty~="" then do
  189.     slablayer=word(empty,1)
  190.     end
  191.   else do    /* Need 1 layer to transform in */
  192.     call notify(1,'!'sysnam,'@Sorry, No Scratch Layer Available')
  193.     return
  194.     end
  195.   box=boundingbox()
  196.   parse var box n x1 x2 y1 y2 z1 z2
  197.   z2=z1+deep*2
  198.   call surface("Slab")
  199.   call MAKEBOX(x1 y1 z1, x2 y2 z2)
  200.   call smoothshift(wide)
  201.   call setblayer(txlayer)
  202.   call BOOLEAN(SUBTRACT)
  203.   call setlayer(txlayer)
  204.   call Cut()
  205.   call setlayer(slablayer)
  206.   call Cut()
  207.   call setlayer(txlayer)
  208.   call Paste()
  209.   return
  210.  
  211. Bevel_Flat:
  212.     call cut
  213.     return
  214.  
  215. Bevel_Block:
  216.     call bevel(0, deep / 2)
  217.     return
  218.  
  219. Bevel_Chisel:
  220.     call shapebevel(-wide wide (-wide) deep/2)
  221.     return
  222.  
  223. Bevel_Round:
  224.     n = 5
  225.     pat = ''
  226.     do i=1 to n
  227.         a = 3.14159/2 * i / n
  228.         pat = pat (-sin(a)*wide) (1-cos(a))*wide
  229.       end i
  230.     call shapebevel(pat (-wide) deep/2)
  231.     return
  232.  
  233. CreateText: PROCEDURE expose font wide styles deep just LineWidth
  234.   parse arg txt,typ
  235.   styles = 'Flat Block Chisel Round'
  236.   origl = curlayer()
  237.   empty = emptylayers()
  238.   if (words(empty) < 2) then do
  239.     call notify 1,syscode,"!Need at least two empty layers","!for this operation."
  240.     exit
  241.     end
  242.   sl1 = word(empty, 1)
  243.   sl2 = word(empty, 2)
  244.   sbase = ''
  245.   do i=1 to words(txt)
  246.     sbase = sbase || word(txt, i)
  247.     if length(sbase) >= 5 then leave
  248.     end
  249.   if length(sbase) > 15 then sbase = left(sbase, 15)
  250.   corners = 'B B S S S'
  251.   call setlayer sl1
  252.   w= maketext(txt, font, word(corners, typ), wide * 2)
  253.   call copy
  254.   call setlayer sl2
  255.   call paste
  256.   call sel_mode('user')
  257.   call sel_polygon('set')
  258.   interpret 'call Bevel_' ||word(styles, typ)
  259.   call cut
  260.   call changesurface(sbase || "_Side")
  261.   call setlayer sl1 /* Get the correct faces from sl1. */
  262.   call changesurface(sbase || "_Face")
  263.   call flip
  264.   call cut
  265.   call setlayer sl2
  266.   call paste
  267.   call mirror(Z, -deep/2)
  268.   call mergepoints
  269.   x=JustifyX(LineWidth,just)
  270.   call cut
  271.   call setlayer origl
  272.   call paste
  273.   return x
  274.